Personalizar nuestra secion
options(digits=3,papersize = "letter")
# https://stat.ethz.ch/R-manual/R-devel/library/base/html/options.html
# Opciones globales en graficas
par(mar=c(5.1,5,4.1,2.1),font=3,family="sans",bg="yellow")
Librerias a usar en nuestro problema
library(naniar)
library(plotly)
## Loading required package: ggplot2
##
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
##
## last_plot
## The following object is masked from 'package:stats':
##
## filter
## The following object is masked from 'package:graphics':
##
## layout
library(fdth)
##
## Attaching package: 'fdth'
## The following objects are masked from 'package:stats':
##
## sd, var
library(agricolae)
library(UsingR)
## Loading required package: MASS
##
## Attaching package: 'MASS'
## The following object is masked from 'package:plotly':
##
## select
## Loading required package: HistData
## Loading required package: Hmisc
## Loading required package: lattice
## Loading required package: survival
## Loading required package: Formula
##
## Attaching package: 'Hmisc'
## The following object is masked from 'package:plotly':
##
## subplot
## The following objects are masked from 'package:base':
##
## format.pval, units
##
## Attaching package: 'UsingR'
## The following object is masked from 'package:survival':
##
## cancer
library(modeest)
## Registered S3 method overwritten by 'rmutil':
## method from
## print.response httr
##
## Attaching package: 'modeest'
## The following object is masked from 'package:agricolae':
##
## skewness
## The following object is masked from 'package:fdth':
##
## mfv
setwd("C:/Users/Emman/Documents/CCH-N} FES-A/fessaa/FES/7mo semestre/Temas Selectos de Estadistica")
datas<- read.csv("./DATA/diabetes.csv", header=T, sep=",", dec=".", fill=F)
head(datas)
## patient_number cholesterol glucose hdl_chol chol_hdl_ratio age gender height
## 1 1 193 77 49 3,9 19 female 61
## 2 2 146 79 41 3,6 19 female 60
## 3 3 217 75 54 4 20 female 67
## 4 4 226 97 70 3,2 20 female 64
## 5 5 164 91 67 2,4 20 female 70
## 6 6 170 69 64 2,7 20 female 64
## weight bmi systolic_bp diastolic_bp waist hip waist_hip_ratio diabetes
## 1 119 22,5 118 70 32 38 0,84 No diabetes
## 2 135 26,4 108 58 33 40 0,83 No diabetes
## 3 187 29,3 110 72 40 45 0,89 No diabetes
## 4 114 19,6 122 64 31 39 0,79 No diabetes
## 5 141 20,2 122 86 32 39 0,82 No diabetes
## 6 161 27,6 108 70 37 40 0,93 No diabetes
tail(datas)
## patient_number cholesterol glucose hdl_chol chol_hdl_ratio age gender
## 385 385 255 112 34 7,5 82 male
## 386 386 227 105 44 5,2 83 female
## 387 387 226 279 52 4,3 84 female
## 388 388 301 90 118 2,6 89 female
## 389 389 232 184 114 2 91 female
## 390 390 165 94 69 2,4 92 female
## height weight bmi systolic_bp diastolic_bp waist hip waist_hip_ratio
## 385 66 163 26,3 179 89 37 43 0,86
## 386 59 125 25,2 150 90 35 40 0,88
## 387 60 192 37,5 144 88 41 48 0,85
## 388 61 115 21,7 218 90 31 41 0,76
## 389 61 127 24 170 82 35 38 0,92
## 390 62 217 39,7 160 82 51 51 1
## diabetes
## 385 No diabetes
## 386 No diabetes
## 387 Diabetes
## 388 No diabetes
## 389 Diabetes
## 390 No diabetes
attach(datas)
pct_miss(datas)
## [1] 0
Un análisis inicial muestra que no existen datos faltantes por lo que no hace falta omitir o imputar.
| Variable | Tipo | Escala de medición |
|---|---|---|
| patient_number | cuantitativa/discreta | intervalo |
| cholesterol | cuantitativa/discreta | intervalo |
| glucose | cuantitativa/discreta | razon |
| hdl_chol | cuantitativa/discreta | intervalo |
| chol_hdl_ratio | cuantitativa/continua | razon |
| age | cuantitativa/discreta | razon |
| gender | cualitativa | nominal |
| height | cuantitativa/discreta | intervalo |
| weight | cuantitativa/discreta | intervalo |
| bmi | cuantitativa/continua | intervalo |
| systolic_bp | cuantitativa/discreta | intervalo |
| diastolic_bp | cuantitativa/discreta | intervalo |
| waist | cuantitativa/discreta | intervalo |
| hip | cuantitativa/discreta | intervalo |
| waist_hip_ratio | cuantitativa/continua | intervalo |
| diabetes | cualitativa | nominal |
La variable va a ser gender, que contiene informacion del genero de las personas con diabetes
#Tabla de frecuencia absolutas
tabla_genero <- table(datas$gender)
print(tabla_genero)
##
## female male
## 228 162
sum(tabla_genero)
## [1] 390
nrow(datas)
## [1] 390
#frecuencias relativas
prop_genero <- round(prop.table(tabla_genero),digits = 3)
print(prop_genero)
##
## female male
## 0.585 0.415
sum(prop_genero)
## [1] 1
Como podemos ver, no existen valor con N/A, y que hay mas mujeres en este estudio, siendo un total de 228 mujeres y 162 hombres
En este caso para el analisis grafico, usare diagrama de barras
barplot(tabla_genero,names.arg=c("Mujer","Hombre"),col=c("blue","red"), ylim=c(0,250))
title("Genero (Frecuencias Absolutas)")
barplot(prop_genero,names.arg=c("Mujer","Hombre"),col=c("blue","red"),,ylim=c(0,0.6))
title("Genero (Frecuencias Relativas)")
De la gráfica de barras se observa que, hay diferencias entre el número de mujeres y hombres, en donde se realizo la toma de datos. Vale la pena analizar estadísticamente si esto es así:
n_muj<- tabla_genero[1] #mujeres
n_hom<- tabla_genero[2] #hombres
prop.test(x=c(n_muj, n_hom), n=c(390,390), conf.level=0.90)
##
## 2-sample test for equality of proportions with continuity correction
##
## data: c(n_muj, n_hom) out of c(390, 390)
## X-squared = 22, df = 1, p-value = 3e-06
## alternative hypothesis: two.sided
## 90 percent confidence interval:
## 0.109 0.230
## sample estimates:
## prop 1 prop 2
## 0.585 0.415
De acuerdo con el intervalo de confianza para la diferencia de proporciones se concluye que SÍ hay diferencia entre el número de mujeres y hombres, de hecho \(p_{hombre}-p_{mujer}<0\); así que la proporción de mujeres si es estadísticamente mayor a la correspondiente de los hombres (como lo muestran las gráficas).
En este caso solo puede obtenerse la moda
mfv(datas$gender)
## [1] "female"
TABLA DE FRECUENCIAS SIMPLE
#Tabla de frecuencias
tab_gluc<-table(glucose)
sum(tab_gluc)
## [1] 390
tab_gluc_abs<-prop.table(tab_gluc)
sum(tab_gluc_abs)
## [1] 1
tab_gluc<-c(tab_gluc,sum(tab_gluc))
tab_gluc_abs<-c(tab_gluc_abs, sum(tab_gluc_abs))
nums<-c(names(tab_gluc))
nums[length(nums)]="Totales"
tab_freq_gluc<-matrix(cbind(tab_gluc, tab_gluc_abs),byrow=T,nrow = 2,ncol=length(nums))
length(tab_freq_gluc)
## [1] 234
colnames(tab_freq_gluc)<-nums
rownames(tab_freq_gluc)<-c("fi", "pi")
tab_freq_gluc
## 48 52 54 56 57 58 59 60 62
## fi 1.00000 1.00000 1.00000 2.00000 1.00000 1.00000 1.00000 1.00000 1.00000
## pi 0.00256 0.00256 0.00256 0.00513 0.00256 0.00256 0.00256 0.00256 0.00256
## 64 65 66 67 68 69 70 71 72 73
## fi 2.00000 2.00000 1.00000 4.0000 2.00000 4.0000 3.00000 6.0000 1.00000 2.00000
## pi 0.00513 0.00513 0.00256 0.0103 0.00513 0.0103 0.00769 0.0154 0.00256 0.00513
## 74 75 76 77 78 79 80 81 82 83
## fi 10.0000 8.0000 10.0000 11.0000 5.0000 7.0000 6.0000 15.0000 10.0000 11.0000
## pi 0.0256 0.0205 0.0256 0.0282 0.0128 0.0179 0.0154 0.0385 0.0256 0.0282
## 84 85 86 87 88 89 90 91 92 93
## fi 12.0000 18.0000 7.0000 12.0000 9.0000 6.0000 10.0000 10.0000 14.0000 3.00000
## pi 0.0308 0.0462 0.0179 0.0308 0.0231 0.0154 0.0256 0.0256 0.0359 0.00769
## 94 95 96 97 98 99 100 101 102 103
## fi 8.0000 7.0000 2.00000 7.0000 3.00000 2.00000 5.0000 8.0000 3.00000 3.00000
## pi 0.0205 0.0179 0.00513 0.0179 0.00769 0.00513 0.0128 0.0205 0.00769 0.00769
## 104 105 106 107 108 109 110 111 112 113
## fi 2.00000 5.0000 5.0000 1.00000 2.00000 3.00000 2.00000 3.00000 5.0000 2.00000
## pi 0.00513 0.0128 0.0128 0.00256 0.00513 0.00769 0.00513 0.00769 0.0128 0.00513
## 115 117 118 119 120 121 122 124 125
## fi 3.00000 1.00000 3.00000 3.00000 5.0000 2.00000 2.00000 1.00000 1.00000
## pi 0.00769 0.00256 0.00769 0.00769 0.0128 0.00513 0.00513 0.00256 0.00256
## 126 128 130 131 133 138 145 153 155
## fi 2.00000 2.00000 2.00000 1.00000 1.00000 1.00000 1.00000 1.00000 3.00000
## pi 0.00513 0.00513 0.00513 0.00256 0.00256 0.00256 0.00256 0.00256 0.00769
## 161 171 172 173 174 176 177 182 184
## fi 1.00000 1.00000 1.00000 3.00000 1.00000 1.00000 1.00000 1.00000 1.00000
## pi 0.00256 0.00256 0.00256 0.00769 0.00256 0.00256 0.00256 0.00256 0.00256
## 185 187 193 196 197 203 206 223 225
## fi 1.00000 1.00000 1.00000 1.00000 2.00000 1.00000 3.00000 1.00000 2.00000
## pi 0.00256 0.00256 0.00256 0.00256 0.00513 0.00256 0.00769 0.00256 0.00513
## 228 233 235 236 239 248 251 255 262
## fi 1.00000 1.00000 1.00000 1.00000 1.00000 1.00000 1.00000 1.00000 1.00000
## pi 0.00256 0.00256 0.00256 0.00256 0.00256 0.00256 0.00256 0.00256 0.00256
## 267 269 270 279 297 299 330 341 342
## fi 1.00000 1.00000 2.00000 1.00000 1.00000 1.00000 1.00000 1.00000 1.00000
## pi 0.00256 0.00256 0.00513 0.00256 0.00256 0.00256 0.00256 0.00256 0.00256
## 369 371 385 Totales
## fi 1.00000 1.00000 1.00000 390
## pi 0.00256 0.00256 0.00256 1
TABLA DE FRECUENCIAS COMPLETA:
INTERVALO STURGES
tabla_completa<- fdt(glucose,breaks="Sturges",right=T); tabla_completa
## Class limits f rf rf(%) cf cf(%)
## (47.52,81.653] 109 0.28 27.95 109 27.9
## (81.653,115.786] 203 0.52 52.05 312 80.0
## (115.786,149.919] 28 0.07 7.18 340 87.2
## (149.919,184.052] 15 0.04 3.85 355 91.0
## (184.052,218.185] 10 0.03 2.56 365 93.6
## (218.185,252.318] 10 0.03 2.56 375 96.2
## (252.318,286.451] 7 0.02 1.79 382 98.0
## (286.451,320.584] 2 0.01 0.51 384 98.5
## (320.584,354.717] 3 0.01 0.77 387 99.2
## (354.717,388.85] 3 0.01 0.77 390 100.0
A partir de la tabla de frecuencias se observa que la mayor frecuencia está en la segunda clase, es decir, en el intervalo de 81.653 a 115.786, lo cual indica que de la población estudiada, la mayoría tiene un nivel de glucosa menor a 140 mg/dl, el cual es un nivel saludable.
#Histograma
hist_glu<-hist(glucose, breaks = seq(40,400,30), plot=T, col = heat.colors(12), prob=T,
main="Histograma de Glucosa", xlab="Nivel de Glucosa (mg/dl)", ylab="%")
lines(density(glucose), col="purple", lwd=3 )
#Poligono
simple.freqpoly(glucose,col=heat.colors(12), lwd=3 , breaks = seq(40,400,30), main="POLÍGONO DE
FRECUENCIAS", xlab="Nivel de Glucosa (mg/dl)", ylab="# de Pacientes")
Las 2 primeras gráficas, Histograma y Polígono de Frecuencias respectivamente confirman que la distribución es unimodal con niveles de Glucosa Saludables
#Caja y brazos
help("plot_ly")
## starting httpd help server ... done
caja<-plot_ly(datas, x= ~glucose, type="box", name="Distribución Glucosa")
layout(p=caja, title= "Caja y Brazos", colorway="red", xaxis=list(title="Glucosa MG/DL"))
El Diagrama de Caja igual confirma la unimodalidad de la distribución con la señalización de la mediana sesgada al lado Izquierdo, sin embargo también expone de manera clara la existencia de múltiples outliers distribuidos no de manera uniforme pero sí con cierta constancia en valores mayores a 150 mg/dl lo cual indica pacientes con alerta de prediabetes o diabetes tipo 2.
1.- MODA
mfv(glucose)
## [1] 85
2.- MEDIANA
median(glucose)
## [1] 90
li=81.653
nn=length(glucose)
FA=109
fmd=203
c=115.786-81.653
print("La mediana obtenida por la fórmula es:")
## [1] "La mediana obtenida por la fórmula es:"
mediana=li+(((nn/2)-FA)/fmd)*c ; mediana
## [1] 96.1
3.- MEDIA
mean(glucose)
## [1] 107
4.- COEFICIENTE DE ASIMETRÍA
skewness(glucose)
## [1] 2.69
ASIMETRÍA POSITIVA El Coeficiente de Asimetría es mayor a 0, por lo que tiene una tendencia a acumularse del lado izquierdo.
5.- CURTOSIS
kurtosis(glucose)
## [1] 7.91
La Curtosis indica una curva LEPTOCÚRTICA(MUY PICUDA)
6.- COEFICIENTE DE DESVIACIÓN
sd(glucose)/mean(glucose)
## [1] 0.501
Para unir la gráfica interactiva y los puntos a analizar se realizó la Ojiva a partir de la tabla de frecuencias con los intervalos de clase a partir de los percentiles cada 5%, posteriormente se obtienen los valores de cada percentil solicitado (0.15, 0.60, 0.95) y finalmente se colocó una sombra circular sobre el área que lo indica.
CUANTILES
quantile(glucose, probs=c(0.15,0.6, 0.95))
## 15% 60% 95%
## 76 94 234
OJIVA
pru<-hist(glucose, breaks=quantile(glucose, probs = (seq(0,1,0.05)) ), plot=F)
hist_glu<-pru
n1<-length(hist_glu$breaks)
tab_glu_oji<- cbind(hist_glu$breaks[-n1],hist_glu$breaks[-1],
hist_glu$counts,
hist_glu$counts/sum(hist_glu$counts),
cumsum(hist_glu$counts),
cumsum(hist_glu$counts/sum(hist_glu$counts)))
tab_glu_oji
## [,1] [,2] [,3] [,4] [,5] [,6]
## 0% 48 68 21 0.0538 21 0.0538
## 5% 68 74 26 0.0667 47 0.1205
## 10% 74 76 18 0.0462 65 0.1667
## 15% 76 78 16 0.0410 81 0.2077
## 20% 78 81 28 0.0718 109 0.2795
## 25% 81 82 10 0.0256 119 0.3051
## 30% 82 84 23 0.0590 142 0.3641
## 35% 84 85 18 0.0462 160 0.4103
## 40% 85 87 19 0.0487 179 0.4590
## 45% 87 90 25 0.0641 204 0.5231
## 50% 90 92 10 0.0256 214 0.5487
## 55% 92 94 25 0.0641 239 0.6128
## 60% 94 97 16 0.0410 255 0.6538
## 65% 97 101 18 0.0462 273 0.7000
## 70% 101 108 19 0.0487 292 0.7487
## 75% 108 115 20 0.0513 312 0.8000
## 80% 115 126 20 0.0513 332 0.8513
## 85% 126 174 19 0.0487 351 0.9000
## 90% 174 234 19 0.0487 370 0.9487
## 95% 234 385 20 0.0513 390 1.0000
dimnames(tab_glu_oji)[[2]]<-c("Linf","Lsup","f","fr","F","Fr")
h1<- data.frame(cbind(tab_glu_oji[,2], tab_glu_oji[,6]))
ojiva<-plot_ly(h1, x= ~tab_glu_oji[,2], y=~tab_glu_oji[,6],
marker=list(size=15, color="purple"),
type="scatter", mode="lines")
layout(p=ojiva,title="Ojiva(Glucosa)",
xaxis=list(title="Límite Superior"),
yaxis=list(title="%"),
shapes=list(
#lineavertical
list(type="line",x0=0, x1=0, y0=0, y1=1, yref="paper"),
#lineahorizontal
list(type="line",x0=0, x1=400, y0=1, y1=1, yref="paper"),
list(type = 'circle',
xref = 'x', x0 = 70, x1 = 80,
yref = 'y', y0 =0.12 , y1 = 0.18,
fillcolor = 'rgb(50, 20, 90)', line = list(color = 'rgb(50, 20, 90)'),
opacity = 0.7),
list(type = 'circle',
xref = 'x', x0 = 89, x1 = 99,
yref = 'y', y0 = 0.56, y1 = 0.63,
fillcolor = 'rgb(30, 100, 120)', line = list(color = 'rgb(30, 100, 120)'),
opacity = 0.7),
list(type = 'circle', name="Percentil 95%",
xref = 'x', x0 = 230, x1 = 240,
yref = 'y', y0 = 0.91, y1 = 0.97,
fillcolor = 'rgb(90, 200, 75)', line = list(color = 'rgb(90, 200, 75)'),
opacity = 0.7)))
## A marker object has been specified, but markers is not in the mode
## Adding markers to the mode...
De tu conjunto de datos, elige dos variables cuantitativas y una cualitativa. Realiza lo siguiente: